home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / loadpole / loadpole.bas < prev   
BASIC Source File  |  1992-02-19  |  14KB  |  304 lines
  1. 10  'GW-BASIC LISTING FOR LOADPOLE (LOADED DIPOLE CALCULATIONS PROGRAM)
  2. 100 ' INITIALIZATION SUBROUTINE (LOADPOLE)
  3. 110    CLS:KEY OFF:SCREEN 9:COLOR 14,0
  4. 120    K=234:PI# = 3.141592654#
  5. 130 ' DICTIONARY OF VARIABLES AND TERMS
  6. 140    ' F = Frequency in megahertz (MHz)
  7. 150    ' A = Overall antenna length (feet)
  8. 160    ' B = Distance of each coil from center (feet)
  9. 170    ' D = Diameter of radiator conductor (inches)
  10. 180 ' End of dictionary
  11. 190 ' EXECUTION SUBROUTINE
  12. 200     GOSUB 440:' Get opening screen and music
  13. 210     GOSUB 2400:' Get dipole graphic screen for 5 seconds
  14. 220     GOSUB 550:' Get opening announcment
  15. 230     GOSUB 910:' Get main menu
  16. 240        ' Test value MENU and execute accordingly
  17. 250          ON MENU GOTO 260,360,100
  18. 260     GOSUB 650:' Get operating frequency (returns F)
  19. 270     GOSUB 780:' Get overall length of antenna in feet (returns A)
  20. 280     GOSUB 1720:' Go test A for correct value referenced to F
  21. 290       IF LL = 1 THEN CLS
  22. 300       IF LL = 1 THEN 230
  23. 310     GOSUB 1210:' Get position of loading coil (returns B)
  24. 320     GOSUB 1830:' Get antenna element conductor diameter (Return D)
  25. 330     GOSUB 2840:' Go do calculations
  26. 340   GOSUB 3010:' Go printout results
  27. 350 GOTO 230
  28. 360 ' END OF PROGRAM SUBROUTINE
  29. 370 CLS
  30. 380 LINE (320,180)-(220,140),3,BF
  31. 390 LINE (330,190)-(210,130),2,B
  32. 400 LOCATE 12,30:PRINT " GOODBYE "
  33. 410 TIMELOOP=TIMER:WHILE TIMER<TIMELOOP+3:WEND
  34. 420 CLS:SCREEN 0
  35. 430 SYSTEM
  36. 440 ' OPENING SCREEN SUBROUTINE
  37. 450    NTE(1)=523.25:NTE(2)=493.88:NTE(3)=523.25:NTE(4)=587.33:NTE(5)=659.26
  38. 460    NTE(6)=698.46:NTE(7)=783.99:NTE(8)=880:NTE(9)=987.77:NTE(10)=1046.5
  39. 470    CLS:SCREEN 9:XXX1=400:XXX2=100:YYY1=50:YYY2=200:M=10:COLOR 15
  40. 480    LINE (XXX1,YYY1)-(XXX2,YYY2),,B:SOUND NTE(M),10
  41. 490    M=M-1:IF M = 0 THEN 510 ELSE 500
  42. 500    XXX1=XXX1+10:XXX2=XXX2+10:YYY1=YYY1+10:YYY2=YYY2+10:GOTO 480
  43. 510    COLOR 14:LOCATE 12,34:PRINT "LOADPOLE":COLOR 15
  44. 520    LOCATE 14,26:PRINT "Copyright 1991 J.J. Carr"
  45. 530    TIMELOOP=TIMER:WHILE TIMER < TIMELOOP + 2:WEND
  46. 540 RETURN:' End of subroutine
  47. 550 ' OPENING ANNOUNCEMENT
  48. 560 CLS:COLOR 14
  49. 570    LINE (555,240)-(134,125),3,BF:' Make colored text box
  50. 580    LOCATE 11,20:PRINT "                                                 "
  51. 590    LOCATE 12,20:PRINT " This program calculates the inductive reactance "
  52. 600    LOCATE 13,20:PRINT " and inductance required for loading coils in a  "
  53. 610    LOCATE 14,20:PRINT " shortened dipole antenna.                       "
  54. 620    LOCATE 15,20:PRINT "                                                 "
  55. 630 LOCATE 16,30:GOSUB 2800
  56. 640 RETURN:' End of subroutine
  57. 650 ' PARAMETERS INPUT SUBROUTINE
  58. 660    CLS
  59. 670    LINE (580,195)-(125,140),3,BF
  60. 680 LOCATE 13,20:PRINT " and then press ENTER                           "
  61. 690    LOCATE 12,20:PRINT " Input the operating frequency in megahertz: ";
  62. 700    INPUT F$:' Get frequency in megahertz (alphanumeric)
  63. 710      ' Check for correct input
  64. 720        IF F$="" THEN BEEP
  65. 730        IF F$="" THEN 650
  66. 740        F = VAL(F$)
  67. 750        IF F = 0 THEN BEEP
  68. 760        IF F = 0 THEN 650
  69. 770 RETURN:' End of subroutine
  70. 780 ' OVERALL ANTENNA LENGTH SUBROUTINE
  71. 790     CLS
  72. 800     LINE (580,195)-(125,140),3,BF
  73. 810     LOCATE 13,20:PRINT " and then press ENTER                 "
  74. 820     LOCATE 12,20:PRINT " Input overall antenna length in feet ";
  75. 830     INPUT A$:' Get overall length in feet
  76. 840       ' Check for good input
  77. 850           IF A$="" THEN BEEP
  78. 860           IF A$="" THEN 780
  79. 870           A = VAL(A$)
  80. 880           IF A = 0 THEN BEEP
  81. 890           IF A = 0 THEN 780
  82. 900 RETURN:' End of subroutine
  83. 910 ' MAIN MENU SUBROUTINE
  84. 920     LL = 0
  85. 930     LINE (450,250)-(130,120),3,BF
  86. 940     LOCATE 11,25:PRINT "                          "
  87. 950     LOCATE 12,25:PRINT " (C)alculate values       "
  88. 960     LOCATE 13,25:PRINT " (E)nd program            "
  89. 970     LOCATE 14,25:PRINT " (R)estart entire program "
  90. 980     LOCATE 15,25:PRINT "                          "
  91. 990     LOCATE 17,25:PRINT " Please make selection:   ";
  92. 1000     MENU$=INPUT$(1):' Get menu section
  93. 1010       ' Check for good input
  94. 1020          IF MENU$ = "" THEN BEEP
  95. 1030          IF MENU$ = "" THEN 910
  96. 1040          MENUCHEK = VAL(MENU$)
  97. 1050          IF MENUCHEK > 0 THEN BEEP
  98. 1060          IF MENUCHEK > 0 THEN 910
  99. 1070          IF MENU$ = "0" THEN BEEP
  100. 1080          IF MENU$ = "0" THEN 910
  101. 1090       ' Convert MENU$ to MENU number
  102. 1100          IF MENU$="C" THEN MENU = 1
  103. 1110          IF MENU$="c" THEN MENU = 1
  104. 1120          IF MENU$="E" THEN MENU = 2
  105. 1130          IF MENU$="e" THEN MENU = 2
  106. 1140          IF MENU$="R" THEN MENU = 3
  107. 1150          IF MENU$="r" THEN MENU = 3
  108. 1160          IF MENU > 3 THEN BEEP
  109. 1170          IF MENU > 3 THEN 910
  110. 1180          IF MENU < 1 THEN BEEP
  111. 1190          IF MENU < 1 THEN 910
  112. 1200 RETURN:' End of subroutine
  113. 1210 ' SUBROUTINE TO DETERMINE COIL LOCATION
  114. 1220     CLS
  115. 1230     LINE (550,280)-(120,130),3,BF
  116. 1240     LOCATE 11,20:PRINT "                                              "
  117. 1250     LOCATE 12,20:PRINT " Please select location of coil               "
  118. 1260     LOCATE 13,20:PRINT "                                              "
  119. 1270     LOCATE 14,20:PRINT " (C)enter of each element (50-percent)        "
  120. 1280     LOCATE 15,20:PRINT " (O)ne-third way on each element (33-percent) "
  121. 1290     LOCATE 16,20:PRINT " (F)eedpoint of antenna (0-percent)           "
  122. 1300     LOCATE 17,20:PRINT " (S)elect different location                  "
  123. 1310     LOCATE 18,20:PRINT "                                              "
  124. 1320     LOCATE 19,20:PRINT " Make selection please...                     ";
  125. 1330     B$ = INPUT$(1)
  126. 1340       ' Check for good input
  127. 1350         IF B$ = "" THEN BEEP
  128. 1360         IF B$ = "" THEN 1210
  129. 1370         BCHEK=VAL(B$)
  130. 1380         IF BCHEK > 0 THEN BEEP
  131. 1390         IF BCHEK > 0 THEN 1210
  132. 1400         IF B$="0" THEN BEEP
  133. 1410         IF B$="0" THEN 1210
  134. 1420       ' Convert B$ to B numeric
  135. 1430          IF B$ = "C" THEN B = .5*(A/2)
  136. 1440          IF B$ = "c" THEN B = .5*(A/2)
  137. 1450          IF B$ = "O" THEN B = .333*(A/2)
  138. 1460          IF B$ = "o" THEN B = .333*(A/2)
  139. 1470          IF B$ = "F" THEN B = .0001*(A/2)
  140. 1480          IF B$ = "f" THEN B = .0001*(A/2)
  141. 1490          IF B$ = "S" THEN B = 1
  142. 1500          IF B$ = "s" THEN B = 1
  143. 1510     ' Test value of B numeric
  144. 1520         IF B = 0 THEN BEEP
  145. 1530         IF B = 0 THEN 1210
  146. 1540     ' Decide what to do based on value of B
  147. 1550         IF B = 1 THEN 1570 ELSE 1710
  148. 1560     ' Select own percentage for loading coil
  149. 1570        CLS:LINE (550,240)-(120,130),3,BF
  150. 1580        LOCATE 11,20:PRINT "                                             "
  151. 1590        LOCATE 12,20:PRINT " Enter location of loading coil in feet      "
  152. 1600        LOCATE 13,20:PRINT " from center feed point of antenna. Must     "
  153. 1610        LOCATE 14,20:PRINT " be less than overall length entered before. "
  154. 1620        LOCATE 15,20:PRINT "                                             "
  155. 1630        LOCATE 16,20:PRINT " Input value and press ENTER                 ";
  156. 1640         INPUT B$
  157. 1650         B = VAL(B$)
  158. 1660      ' Check for good input
  159. 1670         IF B = 0 THEN BEEP
  160. 1680         IF B = 0 THEN 1570
  161. 1690         IF B > A THEN BEEP
  162. 1700         IF B > A THEN 1570
  163. 1710 RETURN:' End of subroutine
  164. 1720 ' SUBROUTINE TO TEST FOR VALUE OF "A" RELATIVE TO "F"
  165. 1730     L = 468/F:' Calculate regular length of fullsize dipole
  166. 1740     IF A > L THEN 1750 ELSE 1820:'Compare to full size dipole
  167. 1750     BEEP:CLS:LINE (550,220)-(130,130),3,BF:' Message for L>A error
  168. 1760     LOCATE 11,20:PRINT "                                              "
  169. 1770     LOCATE 12,20:PRINT " Shortened dipole not needed because selected "
  170. 1780     LOCATE 13,20:PRINT " length is longer than half-wavelength at the "
  171. 1790     LOCATE 14,20:PRINT " selected frequency.                          "
  172. 1800     LOCATE 15,20:PRINT "                                              "
  173. 1810 LL=1:TIMELOOP=TIMER:WHILE TIMER<TIMELOOP+3:WEND
  174. 1820 RETURN:' End of subroutine
  175. 1830 ' SUBROUTINE TO DETERMINE ANTENNA CONDUCTOR SIZE
  176. 1840    CLS:' Draw screen
  177. 1850    LINE (520,340)-(125,80),3,BF
  178. 1860    LOCATE  8,20:PRINT "                                       "
  179. 1870    LOCATE 10,20:PRINT "                                       "
  180. 1880    LOCATE  9,20:PRINT " Select antenna element conductor size "
  181. 1890    LOCATE 11,20:PRINT " 1.  #10 wire                          "
  182. 1900    LOCATE 12,20:PRINT " 2.  #12 wire                          "
  183. 1910    LOCATE 13,20:PRINT " 3.  #14 wire                          "
  184. 1920    LOCATE 14,20:PRINT " 4.  #16 wire                          "
  185. 1930    LOCATE 15,20:PRINT " 5.  #18 wire (not recommended)        "
  186. 1940    LOCATE 16,20:PRINT " 6.  #20 wire (not recommended)        "
  187. 1950    LOCATE 17,20:PRINT " 7.  #22 wire (not recommended)        "
  188. 1960    LOCATE 18,20:PRINT " 8.  Aluminum or copper tubing         "
  189. 1970    LOCATE 19,20:PRINT "                                       "
  190. 1980    LOCATE 21,20:PRINT " Make selection...                     ";
  191. 1990    D$ = INPUT$(1)
  192. 2000     'Check for good input
  193. 2010        D = VAL(D$)
  194. 2020        IF D < 1 THEN BEEP
  195. 2030        IF D < 1 THEN 1830
  196. 2040        IF D > 8 THEN BEEP
  197. 2050        IF D > 8 THEN 1830
  198. 2060        IF D = 1 THEN DD$ = " #10 wire "
  199. 2070        IF D = 2 THEN DD$ = " #12 wire "
  200. 2080        IF D = 3 THEN DD$ = " #14 wire "
  201. 2090        IF D = 4 THEN DD$ = " #16 wire "
  202. 2100        IF D = 5 THEN DD$ = " #18 wire "
  203. 2110        IF D = 6 THEN DD$ = " #20 wire "
  204. 2120        IF D = 7 THEN DD$ = " #22 wire "
  205. 2130     ' Select aluminum/copper tubing size
  206. 2140        IF D = 8 THEN 2270 ELSE 2160
  207. 2150        IF D = 8 THEN DD$ = "Alum/Copper Tubing "
  208. 2160        LOCATE 22,20:PRINT DD$
  209. 2170        TIMELOOP=TIMER:WHILE TIMER<TIMELOOP+.5:WEND:CLS
  210. 2180        IF D = 1 THEN D = .1019
  211. 2190        IF D = 2 THEN D = .0808
  212. 2200        IF D = 3 THEN D = .0641
  213. 2210        IF D = 4 THEN D = .0508
  214. 2220        IF D = 5 THEN D = .0403
  215. 2230        IF D = 6 THEN D = .032
  216. 2240        IF D = 7 THEN D = .0253
  217. 2250        IF D = 8 THEN D = D
  218. 2260 GOTO 2380:' Go to end of routine
  219. 2270     ' Subroutine to select tubing diameter
  220. 2280        CLS:LINE (500,200)-(120,120),3,BF:' Draw screen
  221. 2290        LOCATE 12,20:PRINT "                                       "
  222. 2300        LOCATE 13,20:PRINT " Select tubing outside diameter (o.d.) "
  223. 2310        LOCATE 14,20:PRINT " 0.5 inch to 2 inch                    ";
  224. 2320        INPUT D:'Enter tubing size
  225. 2330        IF D < .5 THEN BEEP
  226. 2340        IF D < .5 THEN 2270
  227. 2350        IF D > 2 THEN BEEP
  228. 2360        IF D > 2 THEN 2270
  229. 2370        GOTO 2150
  230. 2380 RETURN:' End of subroutine
  231. 2390 LINE (52,105)-(58,110)
  232. 2400 'SUBROUTINE FOR GRAPHIC OPENING
  233. 2410 CLS
  234. 2420 LINE (600,150)-(50,150)
  235. 2430 LINE (600,149)-(50,149)
  236. 2440 LINE (335,150)-(315,150),0,BF
  237. 2450 LINE (335,149)-(315,149),0,BF
  238. 2460 LINE (335,225)-(335,150)
  239. 2470 LINE (315,225)-(315,150)
  240. 2480 LINE (198,155)-(178,145),3,BF
  241. 2490 LINE (473,155)-(453,145),3,BF
  242. 2500 LINE (600,142)-(600,90)
  243. 2510 LINE (50,142)-(50,90)
  244. 2520 LINE (52,105)-(598,105)
  245. 2530 LINE (340,105)-(310,105),0,BF
  246. 2540 LOCATE 8,41:PRINT "A"
  247. 2550 LINE (52,105)-(58,100)
  248. 2560 LINE (52,105)-(58,110)
  249. 2570 LINE (598,105)-(592,100)
  250. 2580 LINE (598,105)-(592,110)
  251. 2590 LINE (449,130)-(202,130)
  252. 2600 LINE (449,145)-(449,125)
  253. 2610 LINE (201,145)-(201,125)
  254. 2620 LINE (337,135)-(313,125),0,BF
  255. 2630 LOCATE 10,32:PRINT " B "
  256. 2640 LOCATE 10,48:PRINT " B "
  257. 2650 LINE (335,143)-(335,125)
  258. 2660 LINE (315,143)-(315,125)
  259. 2670 LINE (315,130)-(310,125)
  260. 2680 LINE (315,130)-(310,135)
  261. 2690 LINE (202,130)-(207,125)
  262. 2700 LINE (202,130)-(207,135)
  263. 2710 LINE (449,130)-(444,125)
  264. 2720 LINE (449,130)-(444,135)
  265. 2730 LINE (335,130)-(340,125)
  266. 2740 LINE (335,130)-(340,135)
  267. 2750 LOCATE 13,24:PRINT "L1"
  268. 2760 LOCATE 13,58:PRINT "L2"
  269. 2770 LOCATE 18,18:PRINT " Form of the inductor loaded shortened dipole "
  270. 2780 TIMELOOP=TIMER:WHILE TIMER<TIMELOOP+5:WEND
  271. 2790 CLS:RETURN:' End of subroutine
  272. 2800 ' SUBROUTINE: Press Any Key
  273. 2810     PRINT " Press any key to continue "
  274. 2820     AA$=INKEY$:IF AA$="" THEN 2820
  275. 2830 RETURN:' End of subroutine
  276. 2840 'CALCULATIONS SUBROUTINE
  277. 2850     CLS:LINE (500,150)-(130,120),3,BF:' Draw screen
  278. 2860      LOCATE 10,30:PRINT " Doing Arithmetic "
  279. 2870     LOCATE 12,30:PRINT "                     "
  280. 2880        'Arithmetic
  281. 2890           MA# = (10^6)/(34*PI#*F)
  282. 2900           MB# = (LOG(((24*(K/F))-B)/(D)) - 1)
  283. 2910           MC# = (K/F) - B
  284. 2920           MD# = (((1 - ((F*B)/(K)) )^2) - 1)
  285. 2930           ME# = (MB#*MD#)/MC#
  286. 2940           MF# = (LOG((1/D)*24*((A/2)-B))) - 1
  287. 2950           MG# = ((((F*A)/2)-(F*B))/K)^2 - 1
  288. 2960           MH# = ((A/2) - B)
  289. 2970           MI# = (MF#*MG#)/MH#
  290. 2980           XL# = MA#*(ME# - MI#)
  291. 2990           LUH# = XL#/(2*PI#*F)
  292. 3000 RETURN:' End of subroutine
  293. 3010 ' RESULTS PRINTOUT SUBROUTINE
  294. 3020 CLS:LINE (550,255)-(120,130),3,BF
  295. 3030 LOCATE 12,20:PRINT " Operating frequency: ";F;" MHz            "
  296. 3040 LOCATE 13,20:PRINT " Overall length of antenna: ";A;" Feet         "
  297. 3050 LOCATE 14,20:PRINT " Distance from center to each coil: ";B;" Feet "
  298. 3060 LOCATE 15,20:PRINT " Inductive reactance of coil : ";
  299. 3070 PRINT USING "#####.#";XL#;:PRINT " Ohms  "
  300. 3080 LOCATE 16,20:PRINT " Inductance of coil: ";
  301. 3090 PRINT USING "####.##";LUH#;:PRINT " uH            "
  302. 3100 LOCATE 18,20:GOSUB 2800
  303. 3110 CLS:RETURN:' End of subroutine
  304.